home *** CD-ROM | disk | FTP | other *** search
- Option Explicit
-
- Declare Function GetCapture% Lib "user" ()
- Declare Function WindowFromPoint Lib "User" (ByVal ptScreen As Any) As Integer
- Declare Function GetTextExtent& Lib "gdi" (ByVal hDC%, ByVal lpString$, ByVal nCount%)
- Declare Function GetWindowLong& Lib "user" (ByVal hWnd%, ByVal nIndex%)
- Declare Function SetWindowLong& Lib "user" (ByVal hWnd%, ByVal nIndex%, ByVal newLong&)
- Declare Function GetSystemMetrics% Lib "user" (ByVal nIndex%)
- Declare Sub SetWindowPos Lib "user" (ByVal hWnd%, ByVal hInsertAfter%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal wFlags%)
-
- Type POINTAPI
- X As Integer
- Y As Integer
- End Type
-
- Type RECT
- Left As Integer
- top As Integer
- right As Integer
- bottom As Integer
- End Type
-
- Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
- Declare Sub GetWindowRect Lib "user" (ByVal hWnd%, lpRect As RECT)
-
- Global Const GWL_STYLE = -16
- Global Const HWND_NOTOPMOST = -2
- Global Const HWND_TOPMOST = -1
- Global Const SM_CXCURSOR = 13
- Global Const SM_CYCURSOR = 14
- Global Const SWP_NOSIZE = &H1
- Global Const SWP_NOMOVE = &H2
- Global Const SWP_NOACTIVATE = &H10
- Global Const SWP_SHOWWINDOW = &H40
- Global Const SWP_NOZORDER = &H4
- Global Const WS_POPUP = &H80000000
-
-
- Global gPoint As POINTAPI
- Global gRect As RECT
- Global gCurrBtn As Integer
- Global gPopHelpActive As Integer
- Global gNumBtns As Integer
-
- Function PointAPIToLong& (aPt As POINTAPI)
-
- PointAPIToLong& = (aPt.Y * (2 ^ 16)) Or (aPt.X)
-
- End Function
-
- Sub ShowHelpMess ()
-
- Dim w As Integer
- Dim h As Integer
- Dim cx As Integer
- Dim cy As Integer
- Dim message As String
- Dim flags As Integer
- Dim hWndOver As Integer
-
- ' set help window size based on length of message text
- message = MDIForm1!pshToolBtn(gCurrBtn).Tag
- w = GetTextExtent(frmPopupHelp!Picture1.hDC, message, Len(message)) And &HFF
- h = GetTextExtent(frmPopupHelp!Picture1.hDC, message, Len(message)) \ 2 ^ 16
- ' fudge factor
- frmPopupHelp!Picture1.Width = w + 6
- frmPopupHelp!Picture1.Height = h + 1
-
- frmPopupHelp.Height = frmPopupHelp!Picture1.Height * screen.TwipsPerPixelY
- frmPopupHelp.Width = frmPopupHelp!Picture1.Width * screen.TwipsPerPixelX
-
- ' print help message
- frmPopupHelp!Picture1.Cls
- frmPopupHelp!Picture1.CurrentY = -1
- frmPopupHelp!Picture1.CurrentX = 2
- frmPopupHelp!Picture1.Print message
-
- ' position help message window relative to cursor
- Call GetCursorPos(gPoint)
- cy = GetSystemMetrics(SM_CYCURSOR)
- ' fudge factors
- frmPopupHelp.top = (gPoint.Y + cy - 10) * screen.TwipsPerPixelY
- frmPopupHelp.Left = (gPoint.X - 2) * screen.TwipsPerPixelX
-
- ' Adjust position of popup if needed, ie - don't let
- ' message run off screen
- If frmPopupHelp.top + frmPopupHelp.Height > screen.Height Then
- frmPopupHelp.top = screen.Height - frmPopupHelp.Height
- ' don't cover the button either
- hWndOver = WindowFromPoint(PointAPIToLong&(gPoint))
- Call GetWindowRect(hWndOver, gRect)
- If frmPopupHelp.top + frmPopupHelp.Height > gRect.top * screen.TwipsPerPixelY Then
- frmPopupHelp.top = (gRect.top * screen.TwipsPerPixelY) - frmPopupHelp.Height
- End If
- End If
-
- If frmPopupHelp.Left + frmPopupHelp.Width > screen.Width Then
- frmPopupHelp.Left = screen.Width - frmPopupHelp.Width
- End If
-
- ' display window; SWP_NOACTIVATE is the key here...
- flags = SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
- Call SetWindowPos(frmPopupHelp.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
-
- End Sub
-
-